00100	(DE THM(X)(INITIAL X -200 0))
00200	
00300	(DEFPROP INITIAL 
00400	 (LAMBDA(E L U)
00500	  (PROG (Z Z1)
00600		(COND ((NULL E) (RETURN (LIST NIL))))
00700	   A    (COND ((NULL E) (RETURN Z)))
00800		(SETQ Z1 (CDR (ANCESTOR (CAR E))))
00900		(COND ((AND (NUMBERP Z1) (NOT (LESSP Z1 L)) (NOT (GREATERP Z1 U))) (SETQ Z (NCONC Z (LIST (CAR E))))))
01000		(SETQ E (CDR E))
01100		(GO A))) 
01200	EXPR)
01300	
01400	(DEFPROP INITIALAX1 
01500	 (LAMBDA(L1)
01600	  (PROG (Z L AXNO)
01605	(SETQ L L1)
01610	B1(SETQ L2 L)
01615	A1(COND((EQ(CAR L) (CADR L2))(RPLACD L2(CDDR L2))(GO A1)))
01620	(SETQ L2(CDR L2))
01625	(COND(L2(GO A1)))
01630	(SETQ L(CDR L))
01635	(COND(L(GO B1)))
01640	
01700		(SETQ AXNO -100)
01800		(SETQ L L1)
01900	   B    (SETQ Z (CDDAAR L))
02000		(COND ((NULL (CAAAR L)) (RPLACA (CAAR L) (LENGTH (CDAR L))))
02100		      ((NUMBERP (CAAAR L)) NIL)
02200		      (T (RPLACA (CAAR L) (CAAAAR L))))
02300		(COND ((NUMBERP (CDDR Z)) (GO A)))
02400		(RPLACD Z (CONS (CDR Z) (SETQ AXNO (SUB1 AXNO))))
02500	   A    (SETQ L (CDR L))
02600		(COND (L (GO B)))
02700		(RETURN L1))) 
02800	EXPR)